home *** CD-ROM | disk | FTP | other *** search
/ Celestin Apprentice 4 / Apprentice-Release4.iso / Languages / PowerMacOberon 1.2 / Source / Elems / BalloonElems.Mod (.txt) < prev    next >
Oberon Text  |  1995-08-22  |  15KB  |  396 lines
  1. Syntax10.Scn.Fnt
  2. StampElems
  3. Alloc
  4. 5 Jul 95
  5. Syntax10b.Scn.Fnt
  6. Syntax10i.Scn.Fnt
  7. MarkElems
  8. Alloc
  9. MODULE BalloonElems; (* HM 13 Oct 94 / 
  10. (*------------------------------------------------------------------------------------
  11. Automatically installs a TextFrame handler that intercepts MM+MR clicks and shows a popup text
  12. with an explanation of the word that was clicked at.
  13. The module also provides Balloon elements containing a dictionary of words and their explanation.
  14.     Dictionary = {Word Explanation}.
  15.     Word = string.
  16.     Explanation = <any text not containing a quote>.
  17. ------------------------------------------------------------------------------------*)
  18. IMPORT Display, Input, Files, Viewers, Texts, TextFrames, Oberon, PopupElems, HandlerElems, Bitmaps;
  19. CONST
  20.     left =2; middle = 1; right = 0;
  21.     cancel = {left, middle, right};
  22.     pixel = LONG(10000);
  23.     CR = 0DX;
  24.     grey2 = 13;
  25.     Elem* = POINTER TO ElemDesc;
  26.     ElemDesc* = RECORD (PopupElems.ElemDesc) END;
  27.     Node = POINTER TO NodeDesc;
  28.     NodeDesc = RECORD
  29.         key: ARRAY 32 OF CHAR;
  30.         pos: LONGINT;
  31.         left, right: Node
  32.     END;
  33.     icon: Display.Pattern;
  34.     SuperHandle: Display.Handler;
  35.     stdDict: Texts.Text;  (*search a name in this dictionary if it is not found in any local dictionary*)
  36.     tree: Node;    (*standard directory tree*)
  37.     w: Texts.Writer;
  38. (*----- Balloon Elements -----*)
  39. PROCEDURE 
  40. Handle* (e: Texts.Elem; VAR m: Texts.ElemMsg);
  41.     VAR e1: Elem; buf: Texts.Buffer; f: TextFrames.Frame; v, v0: Viewers.Viewer; x, y: INTEGER;
  42. BEGIN
  43.     WITH e: Elem DO
  44.         WITH m: Texts.CopyMsg DO
  45.             IF m.e = NIL THEN NEW(e1); m.e := e1 END;
  46.             PopupElems.Handle(e, m)
  47.         | m: Texts.IdentifyMsg DO
  48.             m.mod := "BalloonElems"; m.proc := "Alloc"
  49.         | m: TextFrames.DisplayMsg DO
  50.             IF m.prepare THEN
  51.                 e.W := 13 * pixel; e.H := LONG(TextFrames.menuH-1) * pixel;
  52.             ELSE e.name := ""; PopupElems.Handle(e, m);
  53.                 Display.CopyPattern(Display.white, icon, m.X0+2, m.Y0+2, Display.paint)
  54.             END
  55.         | m: TextFrames.TrackMsg DO
  56.             Texts.Delete(e.menu, 0, e.menu.len); (*save it in recall buffer*)
  57.             Texts.Write(w, " "); Texts.Append(e.menu, w.buf); PopupElems.MeasureMenu(e);
  58.             Oberon.AllocateUserViewer(Oberon.Mouse.X, x, y);
  59.             v0 := Viewers.This(x, y-1); PopupElems.Handle(e, m); v := Viewers.This(x, y-1);
  60.             Texts.Recall(buf);
  61.             IF v # v0 THEN (*v is the edit viewer*)
  62.                 f := v.dsc.next(TextFrames.Frame);
  63.                 Texts.Delete(f.text, 0, 1); Texts.Append(f.text, buf); Texts.Save(f.text, 0, f.text.len, buf)
  64.             END;
  65.             Texts.Delete(e.menu, 0, 1); Texts.Append(e.menu, buf)
  66.         ELSE PopupElems.Handle(e, m)
  67.         END
  68. END Handle;
  69. PROCEDURE 
  70. Alloc*;
  71.     VAR e: Elem;
  72. BEGIN
  73.     NEW(e); e.handle := Handle; Texts.new := e
  74. END Alloc;
  75. PROCEDURE 
  76. Insert*;
  77.     VAR e: Elem; insert: TextFrames.InsertElemMsg;
  78. BEGIN
  79.     NEW(e); e.handle := Handle; e.name := ""; e.small := TRUE;
  80.     e.menu := TextFrames.Text(""); PopupElems.MeasureMenu(e);
  81.     insert.e := e; Viewers.Broadcast(insert)
  82. END Insert;
  83. (*----- Binary Tree -----*)
  84. PROCEDURE 
  85. Add (key: ARRAY OF CHAR; pos: LONGINT);
  86.     VAR p, q, father: Node; n: INTEGER;
  87. BEGIN
  88.     p := tree.right; father := tree;
  89.     WHILE p # NIL DO
  90.         father := p;
  91.         IF key < p.key THEN p := p.left ELSE p := p.right END
  92.     END;
  93.     NEW(q); COPY(key, q.key); q.pos := pos;
  94.     IF key < father.key THEN father.left := q ELSE father.right := q END
  95. END Add;
  96. PROCEDURE 
  97. Balance;  (*CACM Sept.86, pp. 902*)
  98.     VAR p, tail, rest: Node; size, n, i: INTEGER;
  99.     PROCEDURE Compress (root: Node; n: INTEGER);
  100.         VAR p, son: Node; i: INTEGER;
  101.     BEGIN
  102.         p := root;
  103.         FOR i := 1 TO n DO
  104.             son := p.right; p.right := son.right; p := p.right;
  105.             son.right := p.left; p.left := son
  106.         END
  107.     END Compress;
  108. BEGIN
  109.     (*--- make vine ---*)
  110.     tail := tree; rest := tail.right;
  111.     size := 0;
  112.     WHILE rest # NIL DO
  113.         IF rest.left = NIL THEN (*move tail down one*)
  114.             tail := rest; rest := rest.right; INC(size)
  115.         ELSE (*rotate*)
  116.             p := rest.left; rest.left := p.right; p.right := rest; rest := p;
  117.             tail.right := p
  118.         END
  119.     END;
  120.     (*--- make tree ---*)
  121.     i := 1; WHILE i <= size+1 DO i := i + i END;
  122.     n := i DIV 2 - 1;
  123.     Compress(tree, size - n);
  124.     WHILE n > 1 DO
  125.         n := n DIV 2; Compress(tree, n)
  126. END Balance;
  127. (*----- Name Lookup -----*)
  128. PROCEDURE 
  129. InvertRect (f: TextFrames.Frame; x, y, w, h: INTEGER);    (*clips to right and bottom frame margin*)
  130. BEGIN
  131.     IF x + w > f.X + f.W - f.right THEN w := f.X + f.W - f.right - x END;
  132.     IF y >= f.Y + f.bot THEN Display.ReplConst(Display.white, x, y, w, h, Display.invert) END
  133. END InvertRect;
  134. PROCEDURE 
  135. TrackMouse (VAR x, y: INTEGER; VAR keys, keysum: SET);
  136. BEGIN
  137.     Input.Mouse(keys, x, y); keysum := keysum + keys;
  138.     Oberon.DrawCursor(Oberon.Mouse, Oberon.Arrow, x, y)
  139. END TrackMouse;
  140. PROCEDURE 
  141. CanBeWord (f: Display.Frame; x, y: INTEGER): BOOLEAN;
  142.     VAR tf: TextFrames.Frame; r: Texts.Reader; ch: CHAR;
  143. BEGIN
  144.     tf := f(TextFrames.Frame);
  145.     Texts.OpenReader(r, tf.text, TextFrames.Pos(tf, x, y)); Texts.Read(r, ch);
  146.     RETURN (r.elem = NIL) & (x > tf.X + tf.barW)
  147. END CanBeWord;
  148. PROCEDURE 
  149. GetDict (t: Texts.Text; VAR dict: Texts.Text);
  150.     VAR r: Texts.Reader;
  151. BEGIN
  152.     Texts.OpenReader(r, t, 0); Texts.ReadElem(r);
  153.     IF (r.elem # NIL) & (r.elem IS Elem) THEN dict := r.elem(Elem).menu ELSE dict := NIL END
  154. END GetDict;
  155. PROCEDURE 
  156. WordBeg (t: Texts.Text; pos: LONGINT): LONGINT;
  157.     VAR r: Texts.Reader; ch: CHAR; pos0: LONGINT;
  158. BEGIN
  159.     pos0 := pos; Texts.OpenReader(r, t, pos); Texts.Read(r, ch);
  160.     WHILE (CAP(ch) >= "A") & (CAP(ch) <= "Z") OR (ch >= "0") & (ch <= "9") OR (ch = ".") DO
  161.         DEC(pos); IF pos < 0 THEN RETURN 0 END;
  162.         Texts.OpenReader(r, t, pos); Texts.Read(r, ch)
  163.     END;
  164.     IF pos < pos0 THEN INC(pos) END;
  165.     RETURN pos
  166. END WordBeg;
  167. PROCEDURE 
  168. WordEnd (t: Texts.Text; pos: LONGINT): LONGINT;
  169.     VAR r: Texts.Reader; ch: CHAR; pos0: LONGINT;
  170. BEGIN
  171.     pos0 := pos; Texts.OpenReader(r, t, pos); Texts.Read(r, ch);
  172.     WHILE (CAP(ch) >= "A") & (CAP(ch) <= "Z") OR (ch >= "0") & (ch <= "9") OR (ch = ".") DO
  173.         INC(pos); Texts.Read(r, ch)
  174.     END;
  175.     IF pos = pos0 THEN INC(pos) END;
  176.     RETURN pos
  177. END WordEnd;
  178. PROCEDURE 
  179. GetName (ft: Texts.Text; pos: LONGINT; VAR name, fullName: ARRAY OF CHAR; VAR t: Texts.Text);
  180.     VAR r: Texts.Reader; ch: CHAR; beg, end: LONGINT; i, j: INTEGER; imported: BOOLEAN;
  181.         t0: Texts.Text; mod: ARRAY 32 OF CHAR;
  182. BEGIN
  183.     (*--- read name*)
  184.     beg := WordBeg(ft, pos); end:= WordEnd(ft, pos);
  185.     i := 0; Texts.OpenReader(r, ft, beg); imported := FALSE;
  186.     WHILE beg < end DO
  187.         Texts.Read(r, ch); name[i] := ch; INC(i); INC(beg);
  188.         IF ch = "." THEN imported := TRUE END
  189.     END;
  190.     name[i] := 0X; COPY(name, fullName);
  191.     (*--- resolve import if necessary*)
  192.     t := ft;
  193.     IF imported THEN
  194.         i := 0; WHILE name[i] # "." DO mod[i] := name[i]; INC(i) END;
  195.         mod[i] := "."; mod[i+1] := "M"; mod[i+2] := "o"; mod[i+3] := "d"; mod[i+4] := 0X;
  196.         NEW(t0); Texts.Open(t0, mod);
  197.         IF t0.len > 0 THEN
  198.             t := t0; j := 0;
  199.             REPEAT INC(i); name[j] := name[i]; INC(j) UNTIL name[i] = 0X
  200.         END
  201. END GetName;
  202. PROCEDURE 
  203. PrefixName (VAR name: ARRAY OF CHAR; f: TextFrames.Frame);
  204.     VAR v: Viewers.Viewer; s: Texts.Scanner; i, j: INTEGER; nm: ARRAY 64 OF CHAR;
  205. BEGIN
  206.     v := Viewers.This(f.X, f.Y);
  207.     Texts.OpenScanner(s, v.dsc(TextFrames.Frame).text, 0); Texts.Scan(s);
  208.     COPY(s.s, nm); i := s.len-1;
  209.     WHILE (i >= 0) & (nm[i] # ".") DO DEC(i) END;
  210.     INC(i); j := 0;
  211.     WHILE (i < 63) & (name[j] # 0X) DO nm[i] := name[j]; INC(i); INC(j) END;
  212.     nm[i] := 0X; COPY(nm, name)
  213. END PrefixName;
  214. PROCEDURE 
  215. MeasureLine (VAR r: Texts.Reader; VAR lw, lh, dsr: INTEGER);
  216.     VAR ch: CHAR; x, y, w, h, dx: INTEGER; p: Display.Pattern;
  217. BEGIN
  218.     Texts.Read(r, ch); lw := 0; lh := 0; dsr := 0;
  219.     WHILE ~r.eot & (ch # CR) DO
  220.         IF r.elem # NIL THEN
  221.             h := SHORT(r.elem.H DIV pixel); dx := SHORT(r.elem.W DIV pixel); y := r.fnt.minY
  222.         ELSE
  223.             Display.GetChar(r.fnt.raster, ch, dx, x, y, w, h, p); INC(y, r.fnt.height * r.voff DIV 64);
  224.         END;
  225.         IF y < dsr THEN dsr := y END;
  226.         IF y + h > lh THEN lh := y + h END;
  227.         INC(lw, dx);
  228.         Texts.Read(r, ch)
  229.     END;
  230.     dsr := -dsr; lh := lh + dsr;
  231.     IF (ch = CR) & (lh = 0) THEN lh := 10; dsr := 0; lw := 8 END
  232. END MeasureLine;
  233. PROCEDURE 
  234. Popup* (t: Texts.Text; beg, end: LONGINT);
  235.     VAR r: Texts.Reader; ch: CHAR; x, y, w, h, dx, bx, by, bw, bh, lw, i, X, Y: INTEGER; b: Bitmaps.Bitmap; p: Display.Pattern;
  236.         lh, dsr: ARRAY 128 OF INTEGER; e: Texts.Elem; dsp: TextFrames.DisplayMsg; keys: SET;
  237. BEGIN
  238.     (*--- measure text*)
  239.     Input.Mouse(keys, x, y);
  240.     bw := 0; bh := 0;
  241.     Texts.OpenReader(r, t, beg); i := 0;
  242.     WHILE Texts.Pos(r) < end DO
  243.         MeasureLine(r, lw, lh[i], dsr[i]);
  244.         IF lw > bw THEN bw := lw END;
  245.         bh := bh + lh[i]; INC(i)
  246.     END;
  247.     INC(bw, 8); IF bw > Display.Width THEN bw := Display.Width END;
  248.     INC(bh, 8); IF bh > Display.Height THEN bh := Display.Height END;
  249.     bx := x; IF bx + bw > Display.Width THEN bx := Display.Width - bw END;
  250.     by := y + 10; IF by + bh > Display.Height THEN by := Display.Height - bh END;
  251.     (*--- show text*)
  252.     b := Bitmaps.New(bw, bh); Bitmaps.CopyBlock(Bitmaps.Disp, b, bx, by, bw, bh, 0, 0, 0);
  253.     Display.ReplConst(Display.white, bx, by, bw, bh, Display.replace);
  254.     Display.ReplConst(grey2, bx+1, by+1, bw-2, bh-2, Display.replace);
  255.     X := bx + 4; Y := by + bh - 4 - lh[0] + dsr[0];
  256.     Texts.OpenReader(r, t, beg); i := 0;
  257.     WHILE beg < end DO
  258.         Texts.Read(r, ch); INC(beg);
  259.         IF ch = CR THEN
  260.             INC(i); X := bx + 4; Y := Y - dsr[i-1] - lh[i] + dsr[i]
  261.         ELSIF r.elem # NIL THEN
  262.             e := r.elem; y := r.fnt.minY;
  263.             dsp.prepare := FALSE; dsp.fnt := r.fnt; dsp.col := r.col; dsp.pos := beg - 1;
  264.             dsp.frame := NIL; dsp.X0 := X; dsp.Y0 := Y+y; dsp.elemFrame := NIL;
  265.             e.handle(e, dsp); INC(X, SHORT(e.W DIV pixel))
  266.         ELSE
  267.             Display.GetChar(r.fnt.raster, ch, dx, x, y, w, h, p); INC(y, r.fnt.height * r.voff DIV 64);
  268.             Display.CopyPattern(Display.white, p, X+x, Y+y, Display.paint); X := X + dx
  269.         END
  270.     END;
  271.     (*--- wait until right mouse button is released*)
  272.     REPEAT Input.Mouse(keys, x, y) UNTIL ~(right IN keys);
  273.     Bitmaps.CopyBlock(b, Bitmaps.Disp, 0, 0, bw, bh, bx, by, 0)
  274. END Popup;
  275. PROCEDURE 
  276. GetBounds (VAR s: Texts.Scanner; t: Texts.Text; VAR beg, end: LONGINT);
  277.     VAR ch: CHAR;
  278. BEGIN
  279.     IF ~s.eot THEN beg := Texts.Pos(s); Texts.Read(s, ch);
  280.         WHILE ~s.eot & (ch <= " ") & (ch # Texts.ElemChar) DO INC(beg); Texts.Read(s, ch) END;
  281.         end := beg;
  282.         WHILE ~s.eot & (ch # '"') DO INC(end); Texts.Read(s, ch) END;
  283.         REPEAT DEC(end); Texts.OpenReader(s, t, end); Texts.Read(s, ch) UNTIL (ch > " ") OR (ch = Texts.ElemChar);
  284.         INC(end);
  285.         IF beg >= end THEN beg := -1 END
  286.     ELSE beg := -1
  287.     END;
  288. END GetBounds;
  289. PROCEDURE 
  290. Show (nm: ARRAY OF CHAR; dict: Texts.Text; VAR done: BOOLEAN);
  291.     VAR s: Texts.Scanner; ch: CHAR; name: ARRAY 64 OF CHAR; beg, end: LONGINT;
  292. BEGIN
  293.     COPY(nm, name); (*circumvent compiler bug*)
  294.     Texts.OpenScanner(s, dict, 0); Texts.Scan(s);
  295.     WHILE ~s.eot & ~((s.class = Texts.String) & (s.s = name)) DO
  296.         Texts.Scan(s)
  297.     END;
  298.     GetBounds(s, dict, beg, end);
  299.     IF beg >= 0 THEN Popup(dict, beg, end) END;
  300.     done := beg >= 0
  301. END Show;
  302. PROCEDURE 
  303. ShowStd (name: ARRAY OF CHAR; VAR done: BOOLEAN);
  304.     VAR p: Node; s: Texts.Scanner; beg, end: LONGINT;
  305. BEGIN
  306.     p := tree.right;
  307.     WHILE (p # NIL) & (p.key # name) DO
  308.         IF name < p.key THEN p := p.left ELSE p := p.right END
  309.     END;
  310.     IF p # NIL THEN
  311.         Texts.OpenScanner(s, stdDict, p.pos);
  312.         GetBounds(s, stdDict, beg, end);
  313.         Popup(stdDict, beg, end)
  314.     END;
  315.     done := p # NIL
  316. END ShowStd;
  317. PROCEDURE 
  318. TrackWord (f: TextFrames.Frame; VAR m: Oberon.InputMsg);
  319.     VAR keys: SET; new, old: TextFrames.Location; dict, t: Texts.Text; name, fullName: ARRAY 64 OF CHAR;
  320.         beg, end: LONGINT; x, y: INTEGER; done: BOOLEAN;
  321. BEGIN
  322.     TextFrames.LocateWord(f, x, y, old); InvertRect(f, old.x, old.y, old.dx, 2);
  323.     m.keys := {};
  324.     TrackMouse(x, y, keys, m.keys);
  325.     WHILE (keys # {}) & ~(left IN keys) DO
  326.         TextFrames.LocateWord(f, x, y, new);
  327.         IF new.pos # old.pos THEN
  328.             InvertRect(f, old.x, old.y, old.dx, 2); InvertRect(f, new.x, new.y, new.dx, 2); old := new
  329.         END;
  330.         IF keys = {middle, right} THEN
  331.             GetName(f.text, TextFrames.Pos(f, x, y), name, fullName, t);
  332.             GetDict(t, dict);
  333.             done := FALSE;
  334.             IF dict # NIL THEN Show(name, dict, done) END;
  335.             IF ~done THEN ShowStd(fullName, done) END;
  336.             IF ~done THEN
  337.                 PrefixName(fullName, f);
  338.                 ShowStd(fullName, done)
  339.             END;
  340.             IF done THEN m.keys := cancel END
  341.         END;
  342.         TrackMouse(x, y, keys, m.keys)
  343.     END;
  344.     InvertRect(f, old.x, old.y, old.dx, 2);
  345.     IF m.keys # cancel THEN EXCL (m.keys, left) END
  346. END TrackWord;
  347. PROCEDURE 
  348. FrameHandler* (f: Display.Frame; VAR m: Display.FrameMsg);
  349. BEGIN
  350.     WITH f: TextFrames.Frame DO
  351.         WITH m: Oberon.InputMsg DO
  352.             IF (m.id = Oberon.track) & (middle IN m.keys) & CanBeWord(f, m.X, m.Y) THEN
  353.                 TrackWord(f(TextFrames.Frame), m);
  354.                 IF m.keys # cancel THEN SuperHandle(f, m) END
  355.             ELSE SuperHandle(f, m)
  356.             END
  357.         ELSE SuperHandle(f, m)
  358.         END
  359. END FrameHandler;
  360. PROCEDURE 
  361. LoadDictionary*;
  362.     VAR s: Texts.Scanner;
  363. BEGIN
  364.     NEW(tree); tree.key := "";
  365.     IF Files.Old("Balloon.Text") # NIL THEN
  366.         NEW(stdDict); Texts.Open(stdDict, "Balloon.Text");
  367.         Texts.OpenScanner(s, stdDict, 0); Texts.Scan(s);
  368.         WHILE ~s.eot DO
  369.             IF s.class = Texts.String THEN Add(s.s, Texts.Pos(s)) END;
  370.             Texts.Scan(s)
  371.         END;
  372.         Balance
  373. END LoadDictionary;
  374. PROCEDURE Install*;    (*loads the module, installs the handler, and reads the dictionary*)
  375. END Install;
  376. PROCEDURE 
  377. InitIcon;
  378.     VAR line: ARRAY 9 OF SET;
  379. BEGIN
  380.     line[8] := {};
  381.     line[7] := {1..6};
  382.     line[6] := {0, 7};
  383.     line[5] := {0, 7};
  384.     line[4] := {0, 7};
  385.     line[3] := {1..4, 6};
  386.     line[2] := {5, 6};
  387.     line[1] := {6, 7};
  388.     icon := Display.NewPattern(line, 8, 8);
  389. END InitIcon;
  390. BEGIN
  391.     InitIcon;
  392.     HandlerElems.SetHandler("BalloonElems.FrameHandler", FrameHandler, SuperHandle);
  393.     LoadDictionary;
  394.     Texts.OpenWriter(w)
  395. END BalloonElems.
  396.